home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / tescrollVH < prev    next >
Encoding:
Text File  |  1994-11-06  |  2.4 KB  |  125 lines  |  [TEXT/MSET]
  1.  \ 28Oct94 dbh updated to 2.5 syntax 
  2.  
  3. (*
  4.  
  5. A tescrollVH is a tescrollV with a vertical scrollbar and
  6. a horizontal scrollbar.
  7.  
  8. *)
  9.  
  10.  
  11. :class texthScroll super{ hscrollBar }
  12.  
  13. \ ScrollOnce: is a late-bound call in the superclass, so this is all we need
  14.  
  15. :m ScrollOnce:
  16.     get: controlWas  get: self -  get: pixDelta *  ( dh)
  17.     0 ( dv)
  18.     pack
  19.     handle: [ get: scrollObject ]    \ will be the TEHandle, of course
  20.     call TEPinScroll
  21.     get: self  put: controlWas
  22.     ;m
  23.  
  24. ;class
  25.  
  26. :class tescrollVH super{ tescrollV }
  27.     texthScroll thscroll
  28.  
  29. :m CalcHScrollValue:  ( -- n )
  30.     ptr: super 8 + ( view) gettopx: rect
  31.     ptr: super ( dest) gettopx: rect -
  32.     ;m
  33.  
  34. :m >dest:  { dx -- }    \ stretch dest rect to the right by dx pixels
  35.     dest: super  ( l t r b )
  36.     swap  dx + swap
  37.     setdest: super ;m
  38.  
  39. \ (new): must only be called at new: time since we store an address to self
  40. \ in a scrollbar, and self may well be an ivar !!
  41. :m (new):
  42.     view: super { l t r b -- }
  43.     l 1- ( x ) b ( y ) r l - 2+ ( len ) init: thscroll
  44.  
  45.     12  40  setscrollValues: thscroll    \ should do something more intelligent here?
  46.     0 90 putrange: thscroll
  47.     ;m
  48.  
  49.     
  50. :m new: { wptr -- }
  51.     wptr new: super
  52.     (new): self
  53.     wptr new: thscroll
  54.         self scrolledBy: thscroll
  55.     550 >dest: self        \ set the dest rect width to 550 pixels
  56.     noWrap: super    \ we don't want wordwrap here.  Also, it's faster.
  57.     ;m
  58.  
  59. :m activate:
  60.     activate: super
  61.     activate: thscroll ;m
  62.     
  63. :m deactivate:
  64.     deactivate: super
  65.     deactivate: thscroll ;m
  66.  
  67. :m release:
  68.     release: super
  69.     release: thscroll ;m
  70.  
  71. :m setControl:    \ actually, we are setting 2 controls
  72.                 \ we keep the setControl: name because this will be called late bound
  73.                 \ from the superclass after a variety of methods.
  74.     setControl: super
  75.     view: super  ( l t r b ) drop nip ( l r ) - abs  ( viewwidth )
  76.     dest: super  ( l t r b ) drop nip ( l r ) - abs  ( destwidth ) swap - 0 max
  77.     0 swap    putrange: thscroll
  78.     CalcHScrollValue: self   set: thscroll
  79.     draw: thscroll
  80.     ;m
  81.  
  82. :m hit?:    ( -- b )
  83.     view: super put: temprect 16 16 stretch: temprect
  84.     where: theMouse
  85.     temprect PtinRect
  86.     ;m
  87.  
  88. :m click:
  89.     hit?: thscroll
  90.         IF    click: thscroll 
  91.             setControl: [self] exit
  92.         THEN
  93.     click: super ;m
  94.  
  95. :m draw:
  96.     draw: super
  97.     draw: thscroll
  98.     ;m
  99.  
  100. :m move:  { dx dy -- }
  101.     dx dy move: super
  102.     dx dy move: thscroll ;m
  103.  
  104. :m moveto:  { x y -- }
  105.     x y moveto: super
  106.     x y moveto: thscroll ;m
  107.  
  108. ;class
  109.  
  110. endload
  111.  
  112. *** EXAMPLE USE
  113.  
  114. selwindow w
  115. test: w
  116.  
  117. tescrollVH tvh
  118. tvh add: w
  119.  
  120. tescrollVH tvh2
  121. 0 100 move: tvh2
  122. tvh2 add: w
  123.  
  124.  
  125.